; NLS
;
;
;
FALSE    EQU 0
TRUE     EQU 1
CR       EQU $8D
;
;
; "IF" STATEMENT EQUATES
;
EQ       EQU "="
NE       EQU "#"
GT       EQU ">"
LT       EQU "<"
GE       EQU ">"|"="*256
LE       EQU "<"|"="*256
;
;
;
;
;
;
;
; SPEED/ASM ENTRY POINTS
;
;
;
; NOTE: THE EQUATE OF PUTC MUST
; BE CHANGED IF YOU RELOCATE
; SPEED/ASM TO SOME LOCATION
; OTHER THAN $7800
;
PUTC     EQU $7000
GETC     EQU PUTC+3
SAGL     EQU GETC+3          ;FOR USE BY S/A ONLY- SEE DOC.
SAPC     EQU SAGL+3          ; "   "   "  "   "     "   "
HOME     EQU SAPC+3          ;HOME AND CLEAR
READLN   EQU HOME+3
INIT     EQU READLN+3
FOR      EQU INIT+3
FOR0     EQU FOR+3
NEXT     EQU FOR0+3
IFI      EQU NEXT+3
IFI0     EQU IFI+3
IFS      EQU IFI0+3
IFS0     EQU IFS+3
MOVE     EQU IFS0+3
LOAD     EQU MOVE+3
MOVS     EQU LOAD+3
LDSTR    EQU MOVS+3
PRINT    EQU LDSTR+3
PRTSTR   EQU PRINT+3
PRTINT   EQU PRTSTR+3
RDSTR    EQU PRTINT+3
RDINT    EQU RDSTR+3
ONXGOTO  EQU RDINT+3
CASE     EQU ONXGOTO+3
CASEI    EQU CASE+3
INSET    EQU CASEI+3
NOTINSET EQU INSET+3
ABS      EQU NOTINSET+3
NEG      EQU ABS+3
MUL      EQU NEG+3
DIV      EQU MUL+3
MOD      EQU DIV+3
RND      EQU MOD+3
SUBSTR   EQU RND+3
INDEX    EQU SUBSTR+3
LENGTH   EQU INDEX+3
CONCAT   EQU LENGTH+3
;
;
;
; STRING FUNCTION TEST ROUTINE.
;
;
         JSR INIT
         JMP TSTSTR
;
;
;
GETRTN   JSR PRINT
         BYT CR,CR,"(Press return to continue):",0
         JSR READLN
         JSR HOME
         RTS 
;
;
;
;
;
TSTSTR:
         JSR HOME
         JSR PRINT
         BYT "String function test routine:",CR,CR
         BYT "Testing LDSTR; A=""ABCD""",CR
         BYT 0
         JSR LDSTR
         ADR A
         BYT "ABCD",0
         BVC >0
         JSR PRINT
         BYT CR,"LDSTR improperly returned an error",CR,0
         JMP >1
;
^0:
;
         JSR PRINT
         BYT "A= ",0
         JSR PRTSTR
         ADR A
;
^1:
         JSR PRINT
         BYT CR
         BYT "Testing LDSTR for string overflow",CR
         BYT "checking: D=""123456""",CR,0
         JSR LDSTR
         .DA D,"123456",#0
         BVC >0
         JSR PRINT
         BYT CR,"LDSTR properly returned an error code",CR,0
         JMP >1
;
^0       JSR PRINT
         BYT "LDSTR did not report an error (uh-oh)",CR,0
;
^1:
         JSR PRINT
         BYT CR,"Testing MOVS; B=A",CR,0
         JSR MOVS
         ADR A,B
         BVC >0
         JSR PRINT
         BYT CR
         BYT "MOVS returned an error code (uh-oh)",CR,0
         JMP >1
;
^0:
;
         JSR PRINT
         BYT "A= ",0
         JSR PRTSTR
         ADR A
         JSR PRINT
         BYT "   b= ",0
         JSR PRTSTR
         ADR B
;
^1:
         JSR PRINT
         BYT CR
         BYT "Testing error handling of MOVS",CR,0
         JSR LDSTR
         .DA B,"123456",#0
         JSR MOVS
         ADR B,D
         BVS >0
         JSR PRINT
         BYT "MOVS did not return an error (uh-oh)",CR,0
         JMP >1
;
^0       JSR PRINT
         BYT "MOVS correctly returned an error",CR,0
;
^1:
         JSR PRINT
         BYT CR,CR,"Testing LENGTH:",CR
         BYT "LENGTH(A)=",0
         JSR LENGTH
         ADR A
         STA I
         LDA #0
         STA I+1
         JSR PRTINT
         ADR I
         JSR PRINT
         BYT CR
         BYT "B=""""",CR
         BYT "LENGTH(B)=",0
         JSR LDSTR
         ADR B
         BYT 0
         JSR LENGTH
         ADR B
         STA I
         LDA #0
         STA I+1
         JSR PRTINT
         ADR I
;
;
         JSR GETRTN
;
; Test the INDEX function.
;
         JSR PRINT
         BYT "Testing the INDEX function:",CR,CR
         BYT "A=""ABCD""",CR
         BYT CR,"B=""C""; INDEX(B,A)=",0
;
         JSR LDSTR
         ADR B
         BYT "C",0
         JSR INDEX
         ADR B,A
         STA I
         LDA #0
         STA I+1
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,"B=""D""; "
         BYT "INDEX(B,A)=",0
         JSR LDSTR
         ADR B
         BYT "D",0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR
         BYT "B=""A""; "
         BYT "INDEX(B,A)=",0
         JSR LDSTR
         ADR B
         BYT "A",0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR
         BYT "B=""B""; "
         BYT "INDEX(B,A)=",0
         JSR LDSTR
         ADR B
         BYT "B",0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,CR
         BYT "B=""BC"";  INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"BC",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR
         BYT "B=""CD""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"CD",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR
         BYT "B=""AB""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"AB",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,CR
         BYT "B=""ABC""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"ABC",#0
;
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,"B=""BCD""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"BCD",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,CR,"B=""ABCD""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,"ABCD",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR GETRTN
;
;
; Test boundry conditions for
; INDEX.
;
         JSR PRINT
         BYT "Testing INDEX boundry conditions",CR,CR
         BYT "A=""ABCD""",CR
         BYT CR,"B=""""; INDEX(B,A)=",0
         JSR LDSTR
         .DA B,#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,"      INDEX(A,B)=",0
         JSR INDEX
         ADR A,B
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,CR
         BYT "A=""""; B=""""; INDEX(A,B)=",0
         JSR LDSTR
         .DA A,#0
         JSR LDSTR
         .DA B,#0
         JSR INDEX
         ADR A,B
         STA I
         JSR PRTINT
         ADR I
;
         JSR PRINT
         BYT CR,CR
         BYT "A=""ABC""; B=""ABCD""; INDEX(B,A)=",0
         JSR LDSTR
         .DA A,"ABC",#0
         JSR LDSTR
         .DA B,"ABCD",#0
         JSR INDEX
         ADR B,A
         STA I
         JSR PRTINT
         ADR I
;
         JSR GETRTN
;
;
; Test the SUBSTR function.
;
         JSR PRINT
         BYT "Testing the SUBSTR function:",CR,CR
         BYT "A=""HELLO THERE, HOW ARE YOU""",CR,0
;
         JSR LDSTR
         .DA A,"HELLO THERE, HOW ARE YOU",#0
         JSR PRINT
         BYT "SUBSTR(A,7,5)=""",0
         JSR LOAD
         ADR 7,I
         JSR LOAD
         ADR 5,J
         JSR SUBSTR
         ADR A,I,J,B
         BVC >0
         JSR PRINT
         BYT CR,"SUBSTR returned an error",CR,0
         JMP >1
;
^0:
         JSR PRTSTR
         ADR B
         JSR PRINT
         BYT """",CR,CR,0
;
^1:
         LDA #10
         STA J
         JSR LOAD
         ADR 1,K
         JSR FOR
         ADR I,K,J,K
;
         JSR SUBSTR
         ADR A,K,I,B
         PHP 
         LDA #"("
         JSR PUTC
         JSR PRTINT
         ADR K
         LDA #","
         JSR PUTC
         JSR PRTINT
         ADR I
         JSR PRINT
         BYT "): ",0
         PLP 
         BVC >1
         JSR PRINT
         BYT "SUBSTR returned an error",0
         JMP >0
;
^1:
         JSR PRTSTR
         ADR B
^0       LDA #CR
         JSR PUTC
         JSR NEXT
;
;
;
         JSR GETRTN
;
;
         JSR FOR0
         ADR I,1,24
;
         JSR SUBSTR
         ADR A,K,I,B
         JSR PRTSTR
         ADR B
         LDA #CR
         JSR PUTC
         JSR DELAY
;
         JSR NEXT
;
;
;
         JSR LOAD
         ADR 1,K
         JSR FOR0
         ADR I,1,24
;
         SEC 
         LDA #25
         SBC I
         STA L
         LDA #0
         STA L+1
;
         JSR FOR
         ADR M,K,I,K
         LDA #" "
         JSR PUTC
         JSR NEXT
;
         JSR SUBSTR
         ADR A,I,L,B
         JSR PRTSTR
         ADR B
         LDA #CR
         JSR PUTC
         JSR DELAY
;
         JSR NEXT
;
;
         JSR GETRTN
;
;
; Test the RDSTR routine.
;
         JSR PRINT
         BYT "Enter a string (up to 40 chars)",CR,":",0
         JSR READLN
         JSR RDSTR
         ADR A
         BVC >0
         JSR PRINT
         BYT "Either you entered more than 40 chars,",CR
         BYT "or RDSTR has a problem",CR,0
;
         JMP >1
;
;
^0       JSR PRINT
         BYT "You entered:",0
         JSR PRTSTR
         ADR A
;
^1:
         JSR PRINT
         BYT CR,"Enter ""123456"":",0
         JSR READLN
         JSR RDSTR
         ADR D
         BVS >0
         JSR PRINT
         BYT "Either you didn't enter ""123456"" or",CR
         BYT "RDSTR has a problem",CR,0
         JMP >1
;
^0       JSR PRINT
         BYT "RDSTR properly returned an error",CR,0
;
^1       JSR GETRTN
;
;
         JSR LDSTR
         .DA A,"ABCD",#0
         JSR MOVS
         ADR A,B
;
         JSR PRINT
         BYT "Testing the IFS function:",CR,CR,CR
         BYT "A=",0
         JSR PRTSTR
         ADR A
         JSR PRINT
         BYT """;  B=""",0
         JSR PRTSTR
         ADR B
         JSR PRINT
         BYT """",CR,0
;
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR A,EQ,B
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR A,NE,B
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR A,GT,B
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR A,LT,B
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR A,GE,B
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR A,LE,B
         JSR YESORNO
;
         JSR PRINT
         BYT CR,"Testing IFS0:",CR,CR
         BYT "Is A=""ABCD""? ",0
         JSR IFS0
         .DA A,EQ,"ABCD",#0
         JSR YESORNO
;
         JSR PRINT
         BYT "Is A <> ""ABCD""? ",0
         JSR IFS0
         .DA A,NE,"ABCD",#0
         JSR YESORNO
;
         JSR GETRTN
;
         JSR PRINT
         BYT "Testing IFS:",CR,CR,0
;
         JSR LDSTR
         .DA B,"ABC",#0
         JSR PRINT
         BYT "A=""ABCD"";  B=""ABC""",CR,CR,0
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR A,EQ,B
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR A,NE,B
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR A,GT,B
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR A,LT,B
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR A,GE,B
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR A,LE,B
         JSR YESORNO
;
         JSR PRINT
         BYT CR
         BYT "A=""ABC""; B=""ABCD""",CR,CR,0
         JSR LDSTR
         .DA A,"ABC",#0
         JSR LDSTR
         .DA B,"ABCD",#0
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR A,EQ,B
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR A,NE,B
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR A,GT,B
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR A,LT,B
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR A,GE,B
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR A,LE,B
         JSR YESORNO
;
         JSR GETRTN
;
;
         JSR PRINT
         BYT "A=""XYZ""; B=""ABCD""",CR,CR
         BYT 0
;
         JSR LDSTR
         .DA A,"XYZ",#0
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR A,EQ,B
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR A,NE,B
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR A,GT,B
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR A,LT,B
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR A,GE,B
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR A,LE,B
         JSR YESORNO
;
         JSR PRINT
         BYT CR
         BYT "A=""ABCD"";  B=""XYZ""",CR,CR,0
;
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR B,EQ,A
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR B,NE,A
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR B,GT,A
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR B,LT,A
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR B,GE,A
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR B,LE,A
         JSR YESORNO
;
         JSR GETRTN
;
         JSR PRINT
         BYT "A=""""; B=""ABCD""",CR,CR,0
;
         JSR LDSTR
         .DA A,#0
         JSR LDSTR
         .DA B,"ABCD",#0
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR A,EQ,B
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR A,NE,B
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR A,GT,B
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR A,LT,B
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR A,GE,B
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR A,LE,B
         JSR YESORNO
;
;
         JSR PRINT
         BYT CR,"A=""ABCD""; B=""""",CR,CR,0
;
         LDA #0
         JSR PUTIS
         JSR IFS
         ADR B,EQ,A
         JSR YESORNO
;
         LDA #1
         JSR PUTIS
         JSR IFS
         ADR B,NE,A
         JSR YESORNO
;
         LDA #2
         JSR PUTIS
         JSR IFS
         ADR B,GT,A
         JSR YESORNO
;
         LDA #3
         JSR PUTIS
         JSR IFS
         ADR B,LT,A
         JSR YESORNO
;
         LDA #4
         JSR PUTIS
         JSR IFS
         ADR B,GE,A
         JSR YESORNO
;
         LDA #5
         JSR PUTIS
         JSR IFS
         ADR B,LE,A
         JSR YESORNO
;
         JSR GETRTN
;
;
         JSR PRINT
         BYT CR
         BYT "Testing the CONCAT function:",CR,CR
         BYT "A=""HELLO""; B="" THERE""",CR
         BYT "C=CONCAT(A,B)",CR,0
;
         JSR LDSTR
         .DA A,"HELLO",#0
         JSR LDSTR
         .DA B," THERE",#0
         JSR CONCAT
         ADR A,B,C
         BVC >0
         JSR PRINT
         BYT "CONCAT returned an error",CR,0
;
^0       JSR PRINT
         BYT "C=""",0
         JSR PRTSTR
         ADR C
         LDA #"""
         JSR PUTC
;
;
         JSR PRINT
         BYT CR,CR
         BYT "Does CONCAT properly check for ovrflw?",CR,0
         JSR CONCAT
         ADR A,B,D
         BVS >0
         JSR PRINT
         BYT "No, it doesn't",CR,0
         JMP >1
;
^0       JSR PRINT
         BYT "Yes, it does",CR,0
;
^1:
         JSR PRINT
         BYT CR
         BYT "A=""""; B=""HELLO THERE""",CR
         BYT "CONCAT(A,B)=""",0
         JSR LDSTR
         .DA A,#0
         JSR CONCAT
         ADR A,C,B
         BVC >0
         JSR PRINT
         BYT "UH-OH, it didn't work",CR,0
;
^0:
         JSR PRTSTR
         ADR B
         JSR PRINT
         BYT """",CR,CR
         BYT "A=""HELLO THERE""; B=""""",CR
         BYT "CONCAT(A,B)=""",0
;
         JSR CONCAT
         ADR C,A,B
         BVC >0
         JSR PRINT
         BYT "UH-OH, it didn't work",CR,0
;
^0:
         JSR PRTSTR
         ADR B
         JSR PRINT
         BYT """",CR,CR,0
;
         JSR GETRTN
;
;
;
;
;
         JSR PRINT
         BYT CR,CR
         BYT "That's all folks...",CR,CR,CR,0
         RTS 
;
;
PUTIS    PHA 
         JSR PRINT
         BYT "Is A ",0
         PLA 
         BNE >0
         LDA #"="
         JSR PUTC
         JMP PRTIT
;
^0       CMP #1
         BNE >1
         JSR PRINT
         BYT "<>",0
         JMP PRTIT
;
^1       CMP #2
         BNE >2
         LDA #">"
         JSR PUTC
         JMP PRTIT
;
^2       CMP #3
         BNE >3
         LDA #"<"
         JSR PUTC
         JMP PRTIT
;
^3       CMP #4
         BNE >4
         JSR PRINT
         BYT ">=",0
         JMP PRTIT
;
^4       JSR PRINT
         BYT "<=",0
;
PRTIT    JSR PRINT
         BYT " B? ",0
         RTS 
;
;
YESORNO  BTR >0
         JSR PRINT
         BYT "NO!",CR,0
         RTS 
;
^0       JSR PRINT
         BYT "YES!",CR,0
         RTS 
;
;
DELAY    JSR FOR0
         ADR M,1,1000
         JSR NEXT
         RTS 
;
;
;
;
;
A        ADR 40
         DFS 40
;
B        ADR 40
         DFS 40
;
C        ADR 40
         DFS 40
;
D        ADR 5
         DFS 5
;
I        ADR 0
J        ADR 0
K        ADR 0
L        ADR 0
M        ADR 0
         END